home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJGRID5.CLS < prev    next >
Text File  |  1996-05-04  |  14KB  |  515 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjGrid3D"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Private Xmin As Single      ' Min X and Y values.
  11. Private Zmin As Single
  12. Public Dx As Single         ' Spacing between rows of data.
  13. Public Dz As Single
  14. Private NumX As Integer     ' Number of X and Y entries.
  15. Private NumZ As Integer
  16. Private Points() As Point3D ' Data values.
  17.  
  18. Private RemoveHidden As Boolean ' Remove hidden surfaces?
  19.  
  20. ' ************************************************
  21. ' Let the user decide if we should draw hidden
  22. ' surfaces.
  23. ' ************************************************
  24. Property Let ShowHidden(value As Boolean)
  25.     RemoveHidden = Not value
  26. End Property
  27. ' ************************************************
  28. ' Tell the user if we are drawing hidden surfaces.
  29. ' ************************************************
  30. Property Get ShowHidden() As Boolean
  31.     ShowHidden = Not RemoveHidden
  32. End Property
  33.  
  34.  
  35. ' ************************************************
  36. ' Draw a line between the points. Set the hi and
  37. ' lo values for the line.
  38. ' ************************************************
  39. Sub DrawAndSetLine(canvas As Object, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, hi() As Integer, lo() As Integer)
  40. Dim tmp As Single
  41. Dim ix As Integer
  42. Dim iy As Integer
  43. Dim y As Single
  44. Dim dy As Single
  45.  
  46.     ' Deal only with integers.
  47.     x1 = CInt(x1)
  48.     y1 = CInt(y1)
  49.     x2 = CInt(x2)
  50.     y2 = CInt(y2)
  51.         
  52.     ' Make x1 < x2.
  53.     If x2 < x1 Then
  54.         tmp = x1
  55.         x1 = x2
  56.         x2 = tmp
  57.         tmp = y1
  58.         y1 = y2
  59.         y2 = tmp
  60.     End If
  61.         
  62.     ' Draw the line.
  63.     canvas.Line (x1, y1)-(x2, y2)
  64.     
  65.     ' Deal with vertical lines separately.
  66.     If x1 = x2 Then
  67.         If y1 < y2 Then
  68.             lo(x1) = y1
  69.             hi(x1) = y2
  70.         Else
  71.             lo(x1) = y2
  72.             hi(x1) = y1
  73.         End If
  74.         Exit Sub
  75.     End If
  76.     
  77.     ' Deal with non-vertical lines.
  78.     dy = (y2 - y1) / CInt(x2 - x1)
  79.     y = y1
  80.     For ix = x1 To x2
  81.         iy = CInt(y)
  82.         
  83.         lo(ix) = iy
  84.         hi(ix) = iy
  85.         
  86.         y = y + dy
  87.     Next ix
  88. End Sub
  89.  
  90.  
  91.  
  92.  
  93. ' ************************************************
  94. ' Draw a line between the points using and
  95. ' updating the hi and lo arrays.
  96. ' ************************************************
  97. Sub DrawLine(canvas As Object, ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single, hi() As Integer, lo() As Integer)
  98. Dim tmp As Single
  99. Dim ix As Integer
  100. Dim iy As Integer
  101. Dim y As Single
  102. Dim dy As Single
  103. Dim firstx As Integer
  104. Dim firsty As Integer
  105. Dim skipping As Boolean
  106. Dim above As Boolean
  107.  
  108.     ' Deal only with integers.
  109.     x1 = CInt(x1)
  110.     y1 = CInt(y1)
  111.     x2 = CInt(x2)
  112.     y2 = CInt(y2)
  113.  
  114.     ' Make x1 < x2.
  115.     If x2 < x1 Then
  116.         tmp = x1
  117.         x1 = x2
  118.         x2 = tmp
  119.         tmp = y1
  120.         y1 = y2
  121.         y2 = tmp
  122.     End If
  123.         
  124.     ' Deal with vertical lines separately.
  125.     If x1 = x2 Then
  126.         ' Make y1 < y2.
  127.         If y2 < y1 Then
  128.             tmp = y1
  129.             y1 = y2
  130.             y2 = tmp
  131.         End If
  132.         If y1 <= lo(x1) Then
  133.             If y2 <= lo(x1) Then
  134.                 canvas.Line (x1, y1)-(x2, y2)
  135.             Else
  136.                 canvas.Line (x1, y1)-(x2, lo(x2))
  137.             End If
  138.             lo(x1) = y1
  139.         End If
  140.         If y2 >= hi(x2) Then
  141.             If y1 >= hi(x2) Then
  142.                 canvas.Line (x1, y1)-(x2, y2)
  143.             Else
  144.                 canvas.Line (x1, hi(x1))-(x2, y2)
  145.             End If
  146.             hi(x2) = y2
  147.         End If
  148.         Exit Sub
  149.     End If
  150.     
  151.     ' Deal with non-vertical lines.
  152.     dy = (y2 - y1) / CInt(x2 - x1)
  153.     y = y1
  154.     
  155.     ' Find the first visible point.
  156.     skipping = True
  157.     For ix = x1 To x2
  158.         iy = CInt(y)
  159.         ' See if this point is visible.
  160.         If iy <= lo(ix) Then
  161.             If skipping Then
  162.                 ' Start a new line below.
  163.                 skipping = False
  164.                 above = False
  165.                 firstx = ix
  166.                 firsty = lo(ix)
  167.             End If
  168.         ElseIf iy >= hi(ix) Then
  169.             If skipping Then
  170.                 ' Start a new line above.
  171.                 skipping = False
  172.                 above = True
  173.                 firstx = ix
  174.                 firsty = hi(ix)
  175.             End If
  176.         Else
  177.             ' This point is not visible.
  178.             If Not skipping Then
  179.                 ' Draw the previous visible line.
  180.                 If above Then
  181.                     ' The line is coming from
  182.                     ' above. Connect it to hi(ix).
  183.                     canvas.Line (firstx, firsty)-(ix, hi(ix))
  184.                 Else
  185.                     ' The line is coming from
  186.                     ' below. Connect it to lo(ix).
  187.                     canvas.Line (firstx, firsty)-(ix, lo(ix))
  188.                 End If
  189.                 
  190.                 skipping = True
  191.             End If
  192.         End If
  193.         
  194.         If iy < lo(ix) Then lo(ix) = iy
  195.         If iy > hi(ix) Then hi(ix) = iy
  196.         
  197.         y = y + dy
  198.     Next ix
  199.  
  200.     ' Draw to the last point if necessary.
  201.     If Not skipping Then _
  202.         canvas.Line (firstx, firsty)-(x2, y2)
  203. End Sub
  204.  
  205. ' ************************************************
  206. ' Create the Points array.
  207. ' ************************************************
  208. Sub SetBounds(x1 As Single, deltax As Single, xnum As Integer, z1 As Single, deltaz As Single, znum As Integer)
  209. Dim i As Integer
  210. Dim j As Integer
  211. Dim x As Single
  212. Dim z As Single
  213.  
  214.     Xmin = x1
  215.     Zmin = z1
  216.     Dx = deltax
  217.     Dz = deltaz
  218.     NumX = xnum
  219.     NumZ = znum
  220.     ReDim Points(1 To NumX, 1 To NumZ)
  221.     
  222.     x = Xmin
  223.     For i = 1 To NumX
  224.         z = Zmin
  225.         For j = 1 To NumZ
  226.             Points(i, j).coord(1) = x
  227.             Points(i, j).coord(2) = 0
  228.             Points(i, j).coord(3) = z
  229.             Points(i, j).coord(4) = 1#
  230.             z = z + Dz
  231.         Next j
  232.         x = x + Dx
  233.     Next i
  234. End Sub
  235. ' ************************************************
  236. ' Save the indicated data value.
  237. ' ************************************************
  238. Sub SetValue(x As Single, y As Single, z As Single)
  239. Dim i As Integer
  240. Dim j As Integer
  241.  
  242.     i = (x - Xmin) / Dx + 1
  243.     j = (z - Zmin) / Dz + 1
  244.     Points(i, j).coord(2) = y
  245. End Sub
  246.  
  247. ' ***********************************************
  248. ' Return a string indicating the object type.
  249. ' ***********************************************
  250. Property Get ObjectType() As String
  251.     ObjectType = "GRID"
  252. End Property
  253.  
  254.  
  255.  
  256. ' ***********************************************
  257. ' Fix the data coordinates at their transformed
  258. ' values.
  259. ' ***********************************************
  260. Public Sub FixPoints()
  261. Dim i As Integer
  262. Dim j As Integer
  263. Dim k As Integer
  264.  
  265.     For i = 1 To NumX
  266.         For j = 1 To NumZ
  267.             For k = 1 To 3
  268.                 Points(i, j).coord(k) = Points(i, j).trans(k)
  269.             Next k
  270.         Next j
  271.     Next i
  272. End Sub
  273.  
  274. ' ************************************************
  275. ' Apply a transformation matrix which may not
  276. ' contain 0, 0, 0, 1 in the last column to the
  277. ' object.
  278. ' ************************************************
  279. Public Sub ApplyFull(M() As Single)
  280. Dim i As Integer
  281. Dim j As Integer
  282.  
  283.     For i = 1 To NumX
  284.         For j = 1 To NumZ
  285.             m3ApplyFull Points(i, j).coord, M, Points(i, j).trans
  286.         Next j
  287.     Next i
  288. End Sub
  289.  
  290. ' ************************************************
  291. ' Apply a transformation matrix to the object.
  292. ' ************************************************
  293. Public Sub Apply(M() As Single)
  294. Dim i As Integer
  295. Dim j As Integer
  296.  
  297.     For i = 1 To NumX
  298.         For j = 1 To NumZ
  299.             m3Apply Points(i, j).coord, M, Points(i, j).trans
  300.         Next j
  301.     Next i
  302. End Sub
  303.  
  304.  
  305. ' ************************************************
  306. ' Apply a nonlinear transformation.
  307. ' ************************************************
  308. Public Sub Distort(D As Object)
  309. Dim i As Integer
  310. Dim j As Integer
  311.  
  312.     For i = 1 To NumX
  313.         For j = 1 To NumZ
  314.             D.Distort Points(i, j).coord(1), Points(i, j).coord(2), Points(i, j).coord(3)
  315.         Next j
  316.     Next i
  317. End Sub
  318.  
  319. ' ************************************************
  320. ' Write a grid to a file using Write.
  321. ' Begin with "GRID" to identify this object.
  322. ' ************************************************
  323. Public Sub FileWrite(filenum As Integer)
  324. Dim i As Integer
  325. Dim j As Integer
  326.  
  327.     ' Write basic information.
  328.     Write #filenum, _
  329.         "GRID", Xmin, Zmin, Dx, Dz, NumX, NumZ
  330.         
  331.     ' Write the Z values.
  332.     For i = 1 To NumX
  333.         For j = 1 To NumZ
  334.             Write #filenum, Points(i, j).coord(2)
  335.         Next j
  336.     Next i
  337. End Sub
  338.  
  339.  
  340.  
  341. ' ************************************************
  342. ' Draw the grid without hidden surfaces using the
  343. ' hi-lo algorithm.
  344. ' ************************************************
  345. Public Sub DrawWithoutHidden(canvas As Object, Optional r As Variant)
  346. Dim Xmin As Integer
  347. Dim Xmax As Integer
  348. Dim lo() As Integer
  349. Dim hi() As Integer
  350. Dim ix As Integer
  351. Dim i As Integer
  352. Dim j As Integer
  353.     
  354.     ' Bound the X values.
  355.     Xmin = Points(1, 1).trans(1)
  356.     Xmax = Xmin
  357.     For i = 1 To NumX
  358.         For j = 1 To NumZ
  359.             ix = CInt(Points(i, j).trans(1))
  360.             If Xmin > ix Then Xmin = ix
  361.             If Xmax < ix Then Xmax = ix
  362.         Next j
  363.     Next i
  364.     
  365.     ' Create the hi and lo arrays.
  366.     ReDim lo(Xmin To Xmax)
  367.     ReDim hi(Xmin To Xmax)
  368.     
  369.     ' Draw the X and Z front edges.
  370.     For i = 2 To NumX
  371.         ' Draw the edge between
  372.         ' Points(i - 1, NumZ) and Points(i, NumZ)
  373.         ' and set hi and lo for its values.
  374.         DrawAndSetLine canvas, _
  375.             Points(i - 1, NumZ).trans(1), _
  376.             Points(i - 1, NumZ).trans(2), _
  377.             Points(i, NumZ).trans(1), _
  378.             Points(i, NumZ).trans(2), _
  379.             hi, lo
  380.     Next i
  381.     For i = 2 To NumZ
  382.         ' Draw the edge between
  383.         ' Points(NumX, i - 1) and Points(NumX, i)
  384.         ' and set hi and lo for its values.
  385.         DrawAndSetLine canvas, _
  386.             Points(NumX, i - 1).trans(1), _
  387.             Points(NumX, i - 1).trans(2), _
  388.             Points(NumX, i).trans(1), _
  389.             Points(NumX, i).trans(2), _
  390.             hi, lo
  391.     Next i
  392.     
  393.     ' Draw the "rectangles."
  394.     For i = NumX - 1 To 1 Step -1
  395.         For j = NumZ - 1 To 1 Step -1
  396.             ' Draw the edges between:
  397.             '   Points(i, j) and Points(i + 1, j)
  398.             '   Points(i, j) and Points(i, j + 1)
  399.             
  400.             ' If the right side of the "rectangle"
  401.             ' leans over the top like this:
  402.             '    +_
  403.             '    | \_
  404.             '    |   \_
  405.             '    +     \_
  406.             '     \      \
  407.             '      +------+
  408.             ' draw the top first so the right side
  409.             ' doesn't make hi() too bit and stop
  410.             ' the top from being drawn.
  411.             '
  412.             ' This only happens with perspective
  413.             ' projection.
  414.             If Points(i + 1, j).trans(1) >= Points(i, j).trans(1) Then
  415.                 DrawLine canvas, _
  416.                     Points(i, j).trans(1), _
  417.                     Points(i, j).trans(2), _
  418.                     Points(i, j + 1).trans(1), _
  419.                     Points(i, j + 1).trans(2), _
  420.                     hi, lo
  421.                 DrawLine canvas, _
  422.                     Points(i, j).trans(1), _
  423.                     Points(i, j).trans(2), _
  424.                     Points(i + 1, j).trans(1), _
  425.                     Points(i + 1, j).trans(2), _
  426.                     hi, lo
  427.             Else
  428.                 DrawLine canvas, _
  429.                     Points(i, j).trans(1), _
  430.                     Points(i, j).trans(2), _
  431.                     Points(i + 1, j).trans(1), _
  432.                     Points(i + 1, j).trans(2), _
  433.                     hi, lo
  434.                 DrawLine canvas, _
  435.                     Points(i, j).trans(1), _
  436.                     Points(i, j).trans(2), _
  437.                     Points(i, j + 1).trans(1), _
  438.                     Points(i, j + 1).trans(2), _
  439.                     hi, lo
  440.             End If
  441.         Next j
  442.     Next i
  443. End Sub
  444.  
  445. ' ************************************************
  446. ' Draw the grid including hidden surfaces.
  447. ' ************************************************
  448. Public Sub DrawWithHidden(canvas As Object, Optional r As Variant)
  449. Dim i As Integer
  450. Dim j As Integer
  451.  
  452.     On Error Resume Next
  453.         
  454.     ' Draw lines parallel to the X axis.
  455.     For i = 1 To NumX
  456.         canvas.CurrentX = Points(i, 1).trans(1)
  457.         canvas.CurrentY = Points(i, 1).trans(2)
  458.         For j = 2 To NumZ
  459.             canvas.Line -(Points(i, j).trans(1), _
  460.                           Points(i, j).trans(2))
  461.         Next j
  462.     Next i
  463.     
  464.     ' Draw lines parallel to the Y axis.
  465.     For j = 1 To NumZ
  466.         canvas.CurrentX = Points(1, j).trans(1)
  467.         canvas.CurrentY = Points(1, j).trans(2)
  468.         For i = 2 To NumX
  469.             canvas.Line -(Points(i, j).trans(1), _
  470.                           Points(i, j).trans(2))
  471.         Next i
  472.     Next j
  473. End Sub
  474.  
  475. ' ************************************************
  476. ' Draw the transformed points on a Form, Printer,
  477. ' or PictureBox.
  478. ' ************************************************
  479. Public Sub Draw(canvas As Object, Optional r As Variant)
  480.     If RemoveHidden Then
  481.         DrawWithoutHidden canvas, r
  482.     Else
  483.         DrawWithHidden canvas, r
  484.     End If
  485. End Sub
  486.  
  487.  
  488.  
  489. ' ************************************************
  490. ' Read a grid from a file using Input.
  491. ' Assume the "GRID" label has alreaDz been
  492. ' read.
  493. ' ************************************************
  494. Public Sub FileInput(filenum As Integer)
  495. Dim i As Integer
  496. Dim j As Integer
  497.  
  498.     ' Get the basic information.
  499.     Input #filenum, Xmin, Zmin, Dx, Dz, NumX, NumZ
  500.     
  501.     ' Allocate the Points array and set the X and
  502.     ' Y values.
  503.     SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ
  504.     
  505.     ' Read the Z values.
  506.     For i = 1 To NumX
  507.         For j = 1 To NumZ
  508.             Input #filenum, Points(i, j).coord(2)
  509.         Next j
  510.     Next i
  511. End Sub
  512.  
  513.  
  514.  
  515.